home *** CD-ROM | disk | FTP | other *** search
/ Delphi 2.0 - Programmer's Utilities Power Pack / Delphi 2.0 Programmer's Utilities Power Pack.iso / s_to_z / tu / btchmain.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-09-15  |  13.5 KB  |  418 lines
  1. unit Btchmain;
  2.  
  3. interface
  4.  
  5. uses
  6.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  7.   Forms, Dialogs, StdCtrls, Rebdlg, Verdlg, Tu, ExtCtrls, DB, DBTables,
  8.   StatDlg, Batchdlg, Getdlg, Errtbdlg, DBIErrs;
  9.  
  10. type
  11.   TFormBatchMain = class(TForm)
  12.     TUtilityVerReb: TTUtility;
  13.     Panel1: TPanel;
  14.     ButtonFixAll: TButton;
  15.     ListBoxStatus: TListBox;
  16.     ButtonDefBatch: TButton;
  17.     ButtonConfirmBatch: TButton;
  18.     ButtonVerifyOnly: TButton;
  19.     ButtonViewErrTable: TButton;
  20.     ButtonSaveLog: TButton;
  21.     Bevel1: TBevel;
  22.     Label7: TLabel;
  23.     Label8: TLabel;
  24.     Label9: TLabel;
  25.     Label10: TLabel;
  26.     Label11: TLabel;
  27.     Label12: TLabel;
  28.     Label13: TLabel;
  29.     Label14: TLabel;
  30.     ButtonClose: TButton;
  31.     Label3: TLabel;
  32.     Label4: TLabel;
  33.     Label2: TLabel;
  34.     label1: TLabel;
  35.     Label5: TLabel;
  36.     LabelBatchName: TLabel;
  37.     Label6: TLabel;
  38.     LabelNumFiles: TLabel;
  39.     SaveDialogActivityLog: TSaveDialog;
  40.     TUtilityVerOnly: TTUtility;
  41.     procedure ButtonFixAllClick(Sender: TObject);
  42.     procedure TUtilityVerRebInfoRebuild(Sender: TObject;
  43.       RebuildCBRec: TRebuildCBData);
  44.     procedure TUtilityVerRebInfoVerify(Sender: TObject;
  45.       VerifyCBRec: TVerifyCBData);
  46.     procedure TUtilityRestInfoVerReb(Sender: TObject; AMessage: String;
  47.       Process: TUVerRebProcess; var Abort: Boolean);
  48.     procedure ButtonDefBatchClick(Sender: TObject);
  49.     procedure ButtonCloseClick(Sender: TObject);
  50.     procedure ButtonConfirmBatchClick(Sender: TObject);
  51.     procedure ButtonVerifyOnlyClick(Sender: TObject);
  52.     procedure ButtonSaveLogClick(Sender: TObject);
  53.     procedure ButtonViewErrTableClick(Sender: TObject);
  54.   private
  55.     { Private declarations }
  56.     CurProcess : TUVerRebProcess; {keep track of the rebuild or verify to eliminate screen flash}
  57.     TablesProcessed : Word;
  58.     Procedure ZeroGages;
  59.     Procedure AssignBatchRec(TU : TTUtility);
  60.     Procedure SendToLog(aMsg : String);
  61.     Procedure UpdateStats(TU : TTUtility);
  62.     procedure DeleteErrorTable;
  63.   public
  64.     { Public declarations }
  65.   end;
  66.  
  67. var
  68.   FormBatchMain: TFormBatchMain;
  69.  
  70. implementation
  71.  
  72. {$R *.DFM}
  73.  
  74. Procedure TFormBatchMain.ZeroGages;
  75. begin
  76.   FormStatus.GaugeHeader.Progress := 0;
  77.   FormStatus.GaugeIndex.Progress := 0;
  78.   FormStatus.GaugeData.Progress := 0;
  79.   FormStatus.GaugeHeaderIdx.Progress := 0;
  80.   FormStatus.GaugeIndexIdx.Progress := 0;
  81.   FormStatus.GaugeDataIdx.Progress := 0;
  82.   FormStatus.GaugeIntegrity.Progress := 0;
  83.   FormStatus.GaugeRebuild.Progress := 0;
  84.   FormStatus.LabelNumPacked.Caption := '';
  85.   FormStatus.LabelNumPacked.refresh;
  86. end;
  87.  
  88. Procedure TFormBatchMain.AssignBatchRec(TU : TTUtility);
  89. begin
  90.   With FormBatchDef do
  91.   begin
  92.     TU.TableName      := TableBatchTableName.value;
  93.     TU.tBkUpTableName := TableBatchBackUpName.value;
  94.     TU.AltStructName  := TableBatchAltStructName.value;
  95.     TU.tKeyVTableName := TableBatchKeyVTableName.value;
  96.     TU.tProbTableName := TableBatchProbTableName.value;
  97.   end;
  98. end;
  99.  
  100. Procedure TFormBatchMain.SendToLog(aMsg : String);
  101. begin
  102.   With ListBoxStatus do
  103.   begin
  104.     Items.Add(AMsg);
  105.     { This next bit scrolls the text so the most recent msg is visible}
  106.     if (ItemHeight * Items.count) > Height then
  107.       TopIndex:= Items.count - (Height div ItemHeight) ;
  108.   end;
  109.   ListBoxStatus.Refresh;
  110. end;
  111.  
  112. Procedure TFormBatchMain.UpdateStats(TU : TTUtility);
  113. Begin
  114.   With FormStatus do
  115.   begin
  116.     LabelStatus.Caption := '';
  117.     LabelNumRecs.Caption         := InttoStr(TU.TblInfo.iRecords);
  118.     LabelRecSize.Caption         := IntToStr(TU.TblInfo.iRecSize);
  119.     LabelNumFields.Caption       := IntToStr(TU.TblInfo.iFields);
  120.     LabelNumAuxPasswords.Caption := IntToStr(TU.TblInfo.iPasswords);
  121.     if TU.TblInfo.bProtected then
  122.       LabelPasswordTF.Caption := 'True'
  123.     else
  124.       LabelPasswordTF.Caption := 'False';
  125.     Inc(TablesProcessed);
  126.     LabelTableOf.Caption := IntToStr(TablesProcessed);
  127.     LabelOfTable.Caption := IntToStr(FormBatchDef.TableBatch.RecordCount);
  128.     GroupBoxTableStats.Refresh;
  129.   end;
  130. end;
  131.  
  132. procedure TFormBatchMain.DeleteErrorTable;
  133. Var
  134.   ErrTblName : String;
  135. begin
  136.   { make sure the error table is not active }
  137.   BtnBottomDlg.TableErrTable.Active := False;
  138.   BtnBottomDlg.TableErrTable.DatabaseName := Session.PrivateDir;
  139.   {Make sure the error table name has an extension }
  140.   if extractFileExt(BtnBottomDlg.TableErrTable.TableName) = '' then
  141.     ErrTblName := BtnBottomDlg.TableErrTable.TableName + '.DB'
  142.   else
  143.     ErrTblName := BtnBottomDlg.TableErrTable.TableName;
  144.   {if the error table  does not have a path then assign the private one}
  145.   if extractFilePath(BtnBottomDlg.TableErrTable.TableName) = '' then
  146.     ErrTblName := Session.PrivateDir + '\' + ErrTblName;
  147.   {Now delete the table if it exists}
  148.   if fileexists(ErrTblName) then
  149.     BtnBottomDlg.TableErrTable.DeleteTable;
  150. end;
  151.  
  152. procedure TFormBatchMain.ButtonFixAllClick(Sender: TObject);
  153. var
  154.   P1,P2 : TPoint;
  155. begin
  156.   ListBoxStatus.Setfocus;
  157.   CurProcess := TURebuilding;
  158.   P1.X := (Width - FormStatus.Width) div 2;
  159.   P1.Y := 100;
  160.   P2 := ClienttoScreen(P1);
  161.   FormStatus.Left := P2.X;
  162.   FormStatus.Top := P2.Y;
  163.   FormStatus.Show;
  164.   Try
  165.     ZeroGages;
  166.     TablesProcessed := 0;
  167.     FormBatchDef.TableBatch.Active := True;
  168.     FormBatchDef.TableBatch.First;
  169.     While not FormBatchDef.TableBatch.EOF do
  170.     begin
  171.       try
  172.         AssignBatchRec(TUtilityVerReb);
  173.         UpdateStats(TUtilityVerReb);
  174.         TUtilityVerReb.ExecuteVerifyRebuild;
  175.       except
  176.         {report the error to the log  so it doesn't stop the process}
  177.         on E:Exception do
  178.           SendToLog(E.Message);
  179.       end;
  180.       try
  181.         ZeroGages;
  182.         FormBatchDef.TableBatch.Next;
  183.       except
  184.       { report the error to the log  so it doesn't stop the process}
  185.         on E:Exception do
  186.           SendToLog(E.Message);
  187.       end;
  188.     end;
  189.   finally
  190.     deletefile(TUtilityVerReb.tErrTableName);
  191.     FormStatus.Hide;
  192.     FormStatus.Refresh;
  193.   end;
  194. end;
  195.  
  196. procedure TFormBatchMain.TUtilityVerRebInfoRebuild(Sender: TObject;
  197.   RebuildCBRec: TRebuildCBData);
  198. begin
  199. { NOTE : This is VERRRRY important. DO NOT MAKE ANY DATABASE CALLS FROM
  200.   THIS METHOD. This event is actually part of a BDE Callback response.
  201.   The rules for Callback responses are clear. The BDE is not re-entrant,
  202.   that means that you can not do anything here that would call the BDE.
  203.   So.... No database calls. Just make pictures.}
  204.   with RebuildCBRec do
  205.   begin
  206.     if sMsg = '' then
  207.     begin
  208.       FormStatus.GaugeRebuild.Progress := iPercentDone;
  209.     end
  210.     else
  211.     begin
  212.       FormStatus.LabelNumPacked.Caption := sMsg;
  213.       FormStatus.LabelNumPacked.refresh;
  214.     end;
  215.   end;
  216. end;
  217.  
  218. procedure TFormBatchMain.TUtilityVerRebInfoVerify(Sender: TObject;
  219.   VerifyCBRec: TVerifyCBData);
  220. begin
  221. { NOTE : This is VERRRRY important. DO NOT MAKE ANY DATABASE CALLS FROM
  222.   THIS METHOD. This event is actually part of a BDE Callback response.
  223.   The rules for Callback responses are clear. The BDE is not re-entrant,
  224.   that means that you can not do anything here that would call the BDE.
  225.   So.... No database calls. Just make pictures.}
  226.   with VerifyCBRec do
  227.   begin
  228.     Case Process of
  229.       TUVerifyTableName :
  230.         begin
  231.           FormStatus.LabelStatus.Caption := TableName;
  232.           FormStatus.LabelStatus.refresh;
  233. {          FormStatus.GroupBoxVerify.refresh; }
  234.         end;
  235.       TUVerifyHeader    : FormStatus.GaugeHeader.Progress := PercentDone;
  236.       TUVerifyIndex     : FormStatus.GaugeIndex.Progress := PercentDone;
  237.       TUVerifyData      : FormStatus.GaugeData.Progress := PercentDone;
  238.       TUVerifySXHeader  : FormStatus.GaugeHeaderIdx.Progress := PercentDone;
  239.       TUVerifySXIndex   : FormStatus.GaugeIndexIdx.Progress := PercentDone;
  240.       TUVerifySXData    : FormStatus.GaugeDataIdx.Progress := PercentDone;
  241.       TUVerifySXIntegrity :   {the index count and current index is passed by the TUVerifySXIntegrity Process}
  242.         begin
  243.           FormStatus.GaugeIntegrity.Progress := PercentDone;
  244.           FormStatus.LabelZeroOf.Caption := IntToStr(CurrentIndex);
  245.           FormStatus.LabelOfZero.Caption := IntToStr(TotalIndex);
  246.           FormStatus.LabelZeroOf.refresh;
  247.           FormStatus.LabelOfZero.refresh;
  248.         end;
  249.     end; {Case}
  250.   end;
  251.  
  252. end;
  253.  
  254. procedure TFormBatchMain.TUtilityRestInfoVerReb(Sender: TObject;
  255.   AMessage: String; Process: TUVerRebProcess; var Abort: Boolean);
  256. begin
  257.   SendToLog(AMessage);
  258.   { use process to highlight the active panal in the status dialog }
  259.   if process <> CurProcess then
  260.   begin
  261.     Case Process of
  262.     TUVerifying  :
  263.       begin
  264.         FormStatus.GroupBoxVerify.Font.Color := clRed;
  265.         FormStatus.GroupBoxRebuild.Font.Color := clBlack;
  266.       end;
  267.     TURebuilding :
  268.       begin
  269.         FormStatus.GroupBoxVerify.Font.Color := clBlack;
  270.         FormStatus.GroupBoxRebuild.Font.Color := clRed;
  271.       end;
  272.     end; {case}
  273.     FormStatus.GroupBoxVerify.refresh;
  274.     FormStatus.GroupBoxRebuild.refresh;
  275.     CurProcess := Process;
  276.   end;
  277. end;
  278.  
  279. procedure TFormBatchMain.ButtonDefBatchClick(Sender: TObject);
  280. var
  281.  temp : Integer;
  282. begin
  283.    DeleteErrorTable;
  284.    If GetBatchDlg.Showmodal = mrOK then
  285.      FormBatchDef.ShowModal;
  286.    { Show the batch selected }
  287.    If GetBatchDlg.modalResult <> mrCancel then
  288.    begin
  289.      LabelBatchName.Caption :=
  290.        ExtractFileName(FormBatchDef.TableBatch.TableName);
  291.      FormBatchDef.TableBatch.Active := True;
  292.      LabelNumFiles.Caption := IntToStr(FormBatchDef.TableBatch.RecordCount) +
  293.        ' Tables';
  294.      FormBatchDef.TableBatch.Active := False;
  295.    end;
  296. end;
  297.  
  298. procedure TFormBatchMain.ButtonCloseClick(Sender: TObject);
  299. begin
  300.   DeleteErrorTable;
  301.   Close;
  302. end;
  303.  
  304. procedure TFormBatchMain.ButtonConfirmBatchClick(Sender: TObject);
  305. begin
  306.   FormBatchDef.TableBatch.Active := True;
  307.   FormBatchDef.TableBatch.First;
  308.   SendToLog('START CHECKING BATCH FOR ERRORS');
  309.   While not FormBatchDef.TableBatch.EOF do
  310.   begin
  311.     With FormBatchDef do
  312.     begin
  313.       if not fileexists(TableBatchTableName.value) then
  314.         SendToLog('Table not found            : '+ TableBatchTableName.value);
  315.       if fileexists(TableBatchBackUpName.value) then
  316.         SendToLog('Backup table already Exists: '+ TableBatchBackUpName.value);
  317.       if not fileexists(TableBatchAltStructName.value) then
  318.         SendToLog('Alternate table not found  : '+ TableBatchAltStructName.value);
  319.       TableBatch.Next;
  320.     end;
  321.   end;
  322.   SendToLog('DONE CHECKING BATCH FOR ERRORS');
  323. end;
  324.  
  325. procedure TFormBatchMain.ButtonVerifyOnlyClick(Sender: TObject);
  326. { There is nothing really special about the ExecuteVerifyRebuild
  327.   method. It just compines the ExecuteVerify and ExecuteRebuild
  328.   into one convient call. The following shows how to just verify all
  329.   the files in the batch}
  330. var
  331.   P1,P2 : TPoint;
  332. begin
  333.   ListBoxStatus.Setfocus;
  334.   CurProcess := TURebuilding;
  335.   P1.X := (Width - FormStatus.Width) div 2;
  336.   P1.Y := 100;
  337.   P2 := ClienttoScreen(P1);
  338.   FormStatus.Left := P2.X;
  339.   FormStatus.Top := P2.Y;
  340.   FormStatus.GroupBoxVerify.Font.Color := clRed;
  341.   TablesProcessed := 0;
  342.   FormStatus.Show;
  343.   FormStatus.Refresh;
  344.   Try
  345.     ZeroGages;
  346.     FormBatchDef.TableBatch.Active := True;
  347.     FormBatchDef.TableBatch.First;
  348.     SendToLog('STARTING VERIFY ONLY PROCESSING OF THE BATCH');
  349.     TUtilityVerOnly.Options := [];
  350.     While not FormBatchDef.TableBatch.EOF do
  351.     begin
  352.       try
  353.         SendToLog('Verifying Table           :' +
  354.            FormBatchDef.TableBatchTableName.value);
  355.         AssignBatchRec(TUtilityVerOnly);
  356.         UpdateStats(TUtilityVerOnly);
  357.         TUtilityVerOnly.ExecuteVerify;
  358.         SendToLog('Verifying Status          : ' +
  359.            IntToStr(TUtilityVerOnly.iErrorLevel));
  360.       except
  361.         {report the error to the log  so it doesn't stop the process}
  362.         on E:Exception do
  363.           SendToLog(E.Message);
  364.       end;
  365.       try
  366.         ZeroGages;
  367.         {now append all errors to the verify only error toble for reporting}
  368.         if fileexists(TUtilityVerOnly.tErrTableName) then
  369.           TUtilityVerOnly.Options := [vTU_Append_Errors];
  370.         FormBatchDef.TableBatch.Next;
  371.       except
  372.         {report the error to the log  so it doesn't stop the process}
  373.         on E:Exception do
  374.           SendToLog(E.Message);
  375.       end;
  376.     end;
  377.   finally
  378.     SendToLog('VERIFY ONLY PROCESSING - COMPLETE');
  379.     FormStatus.Hide;
  380.     FormStatus.GroupBoxRebuild.Font.Color := clBlack;
  381.     FormStatus.Refresh;
  382.   end;
  383. end;
  384.  
  385. procedure TFormBatchMain.ButtonSaveLogClick(Sender: TObject);
  386. begin
  387.    if SaveDialogActivityLog.Execute then
  388.    begin
  389.      ListBoxStatus.Items.SaveToFile(SaveDialogActivityLog.FileName);
  390.      if MessageDlg('Do you want to clear the message log?', mtConfirmation,
  391.         [mbYes, mbNo], 0) = mrYes then
  392.         ListBoxStatus.Items.Clear;
  393.    end;
  394. end;
  395.  
  396. procedure TFormBatchMain.ButtonViewErrTableClick(Sender: TObject);
  397. begin
  398.   BtnBottomDlg.TableErrTable.DatabaseName := Session.PrivateDir;
  399.   BtnBottomDlg.TableErrTable.Active := True;
  400.   BtnBottomDlg.ShowModal;
  401.   { Deactivate Error Table }
  402.   BtnBottomDlg.TableErrTable.Active := False;
  403. end;
  404.  
  405. end.
  406.  
  407. Note - This demo expects an alias named Batch with the Batch.DB file in
  408. it.
  409.  
  410. The designer must remember to set the append option for the error table
  411. when doing batch processing.
  412.  
  413. Make it clear in documentation that all the files that must be checked
  414. must be actvie=false while running under delphi otherwise verify/rebuild
  415. reports that the table is busy.
  416.  
  417. Doc Notes - Verify and Rebuild require that Session.PrivDir be read write.
  418.